﻿Imports System.Windows.Forms
Imports Microsoft.Office.Interop.Word

' OPM: deze class gaat ervan uit dat we met een Nederlandstalige Office werken!

Public Class Documentopmaak

    Const LAYOUTSTIJLNAAM As String = "Lay-outaanwijzing"
    Const STANDAARDOPMAAK As String = "Standaard"

    Private ReadOnly doc As Document = Globals.ThisAddIn.Application.ActiveDocument
    Private ReadOnly selectie As Selection = Globals.ThisAddIn.Application.Selection

    Public Sub LettertypesInstellen(TekstLettertypeParam As String, TitelLettertypeParam As String, TekstLettergrootteParam As Int32, TitelLettergrootteParam As Int32)
        Dim stijl As Style
        Dim alineaIsCursief As Boolean
        Dim alineaIsVet As Boolean

        ' Keuzes opslaan voor volgende keer
        My.Settings.DefaultTitellettertype = TitelLettertypeParam
        My.Settings.DefaultTekstlettertype = TekstLettertypeParam
        My.Settings.DefaultTekstlettergrootte = TekstLettergrootteParam
        My.Settings.DefaultTitellettergrootte = TitelLettergrootteParam
        My.Settings.Save()

        ' Taal instellen en default lettertype toepassen
        selectie.WholeStory()
        selectie.LanguageID = WdLanguageID.wdBelgianDutch
        selectie.Font.Name = TekstLettertypeParam

        ' Koptekstformaten aanpassen: Kop 3 en 4 even groot als tekst, Kop 1 opgegeven waarde, Kop 2 daar tussenin.
        ' OPM: Om de een of andere reden loopt er bij Kop 2 af en toe iets fout, waardoor de lettergrootte verandert.
        TitelLettertypeInstellen("Kop 1", TitelLettertypeParam, TitelLettergrootteParam)
        TitelLettertypeInstellen("Kop 2", TitelLettertypeParam, Math.Round((TitelLettergrootteParam + TekstLettergrootteParam) / 2, 0))
        TitelLettertypeInstellen("Kop 3", TitelLettertypeParam, TekstLettergrootteParam)
        TitelLettertypeInstellen("Kop 4", TitelLettertypeParam, TekstLettergrootteParam)

        ' Correctie
        With doc.Styles("Kop 4").Font
            .Bold = False
            .Italic = True
        End With

        ' Toon bv. "Kop 5" in de galerij zodra we "Kop 4" gebruikt hebben (Kop 1 t.e.m. 4 zijn al toegevoegd)
        doc.FormattingShowNextLevel = True
        doc.FormattingShowFilter = WdShowFilter.wdShowFilterStylesInUse

        ' Nu tekstformaat aanpassen
        TekstLettertypeInstellen(TekstLettertypeParam, TekstLettergrootteParam)


        ' Typische knip-en-plakstijlen verwijderen
        OpmaakstijlVerwijderen("Geen afstand")
        OpmaakstijlVerwijderen("No Spacing")
        OpmaakstijlVerwijderen("Normaal (web)")
        OpmaakstijlVerwijderen("Normal (web)")
        OpmaakstijlVerwijderen("apple-converted-space")
        OpmaakstijlVerwijderen("")

        For Each par As Paragraph In doc.Paragraphs
            stijl = par.Style

            ' Als alle tekst in deze alinea vet of cursief is, is dat normaal gezien via een tekenstijl
            ' toegepast. De alineastijl is bv. Standaard, maar de tekst zelf is vet. Aangezien we alle 
            ' alineastijlen opnieuw toepassen om de huisstijlopmaak af te dwingen, verdwijnen de tekenstijlen.
            ' Afzonderlijke woorden blijven wel hun opmaak behouden, maar als de hele alinea dezelfde opmaak
            ' heeft, loopt het fout. Daarom 

            alineaIsCursief = True
            alineaIsVet = True

            For Each teken As Range In par.Range.Characters
                alineaIsCursief = teken.Font.Italic
                alineaIsVet = teken.Font.Bold

                If alineaIsCursief = False AndAlso alineaIsVet = False Then
                    Exit For
                End If
            Next

            ' Alineastijl opnieuw toepassen
            par.Style = stijl

            ' Correcties voor tekenstijlen die op een hele alinea toegepast zijn
            ' Opgelet: "par.Range.Font.Italic = alineaIsCursief" is niet goed, 
            ' want dat verwijdert opmaak die niet voor heel de alinea geldt.
            If alineaIsCursief Then
                par.Range.Font.Italic = True
            End If

            If alineaIsVet Then
                par.Range.Font.Bold = alineaIsVet
            End If
        Next

        ' Poging om fouten met Kop 2 op te lossen
        TitelLettertypeInstellen("Kop 2", TitelLettertypeParam, Math.Round((TitelLettergrootteParam + TekstLettergrootteParam) / 2, 0))

        ' En terug naar het begin
        selectie.HomeKey(Unit:=WdUnits.wdStory)
        selectie.Find.ClearFormatting()
        selectie.Find.Replacement.ClearFormatting()
    End Sub

    Public Sub LettertypeLayOutAanwijzingenInstellen(Optional LettertypteParam As String = "", Optional LettergrootteParam As Int32 = 0)
        ' Nieuwe stijl aanmaken, voor lay-outaanwijzingen
        Try
            doc.Styles.Add(Name:="Lay-outaanwijzing", Type:=WdStyleType.wdStyleTypeParagraph)
        Catch ex As Exception
            ' bestond blijkbaar al, dus doe maar verder
        End Try

        With doc.Styles(LAYOUTSTIJLNAAM).Font
            .Color = WdColor.wdColorRed
            .Bold = False
            .Italic = False
        End With


        If LettertypteParam <> String.Empty Then
            doc.Styles(layoutstijlnaam).Font.Name = LettertypteParam
        End If

        If LettergrootteParam > 0 Then
            doc.Styles(layoutstijlnaam).Font.Size = LettergrootteParam
        End If

        With doc.Styles(layoutstijlnaam)
            .NoSpaceBetweenParagraphsOfSameStyle = False
            .AutomaticallyUpdate = False
            .BaseStyle = "Standaard"
            .NextParagraphStyle = "Standaard"
            ' Toevoegen aan galerij
            .QuickStyle = True
        End With

        ' Alle rode tekst moet lay-outaanwijzing worden.
        With selectie.Find
            .ClearFormatting()
            .Font.Color = WdColor.wdColorRed
            .Replacement.ClearFormatting()

            ' Alleen de gevonden tekens moeten die stijl krijgen, niet de hele alinea. Vandaar de toevoeging 'Char'. 
            ' Soms loopt dat weleens fout, vandaar de try-catch.
            Try
                .Replacement.Style = doc.Styles(LAYOUTSTIJLNAAM & " Char")
            Catch ex As Exception
                .Replacement.Style = doc.Styles(LAYOUTSTIJLNAAM)
            End Try

            .Text = ""
            .Replacement.Text = ""
            .Forward = True
            .Wrap = WdFindWrap.wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With

        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)
    End Sub

    Public Sub TitelsAnnoteren()
        Dim vlag As Boolean
        Dim isEersteRegel As Boolean
        
        selectie.HomeKey(Unit:=WdUnits.wdStory)

        ' Voor de zekerheid...
        If doc.Styles(layoutstijlnaam) Is Nothing Then
            LettertypeLayOutAanwijzingenInstellen()
        End If

        TitelmarkeringenOpruimen() ' OPM: in de macro is dat verwijderd wegens kans op fouten

        Globals.ThisAddIn.Application.Browser.Target = WdBrowseTarget.wdBrowseHeading
        Globals.ThisAddIn.Application.Browser.Previous() ' hoofdtitel staat dikwijls op eerste regel en wordt anders overgeslagen

        selectie.EndKey(Unit:=WdUnits.wdLine)
        selectie.HomeKey(Unit:=WdUnits.wdLine, Extend:=WdMovementType.wdExtend)
        isEersteRegel = True

        ' Zet bij elke kop achteraan een lay-outaanwijzing die aangeeft
        ' dat het om een titel gaat, en van welk niveau. Geef dat ook
        ' de juiste opmaakstijl.
        Do Until InStr(selectie.Text, ">") > 0
            Dim stijl As Style
            stijl = selectie.Style

            Select Case stijl.NameLocal
                Case "Kop 1", "Kop 1 Char"
                    SelectieAnnoteren("titel 1")
                Case "Kop 2", "Kop 2 Char"
                    SelectieAnnoteren("titel 2")
                Case "Kop 3", "Kop 3 Char"
                    SelectieAnnoteren("titel 3")
                Case "Kop 4", "Kop 4 Char"
                    SelectieAnnoteren("titel 4")
                Case Else
                    If isEersteRegel = False Then
                        SelectieAnnoteren("niet ondersteunde kopstijl")
                        vlag = True
                    End If
            End Select

            Globals.ThisAddIn.Application.Browser.Next()
            isEersteRegel = False

            selectie.EndKey(Unit:=WdUnits.wdLine)
            selectie.HomeKey(Unit:=WdUnits.wdLine, Extend:=WdMovementType.wdExtend)
        Loop

        selectie.HomeKey(Unit:=WdUnits.wdStory)

        If vlag = True Then
            MsgBox("Probleem: het document bevat niet-ondersteunde kopstijlen! Maak je onderverdeling minder ingewikkeld, of zet zelf de lay-outaanwijzingen. Er staat nu '</niet ondersteunde kopstijl>' bij, dus met Ctrl-F kun je dat zoeken.")

            ' Stop het al in de opzoeking. Wordt mogelijk overschreven door een andere vervangingsopdracht.
            selectie.Find.Text = "</niet ondersteunde kopstijl>"

            ' Stop het ook nog eens in het klembord, zodat je Ctrl-F + Ctrl-V kunt doen
            ' Voor het volgende is een referentie nodig naar Microsoft Forms 2.0 Object Library.
            ' Voeg ze toe via Extra > Verwijzingen, of voeg een WinForm toe aan het project.
            Clipboard.SetText("</niet ondersteunde kopstijl>")
        End If
    End Sub

    Private Sub TitelLettertypeInstellen(OpmaakstijlParam As String, LettertypeParam As String, PuntgroottteParam As Int16)
        LettertypeBasisInstellen(OpmaakstijlParam)

        With doc.Styles(OpmaakstijlParam).Font
            .Name = LettertypeParam
            .Size = PuntgroottteParam
            .Bold = True
            .Italic = False
        End With

        doc.Styles(OpmaakstijlParam).BaseStyle = "Standaard"
    End Sub

    Private Sub TekstLettertypeInstellen(LettertypeParam As String, PuntgrootteParam As Int16)
        LettertypeBasisInstellen(STANDAARDOPMAAK)

        With doc.Styles(STANDAARDOPMAAK).Font
            .Name = LettertypeParam
            .Size = PuntgrootteParam
            .Bold = False
            .Italic = False
        End With

        With doc.Styles(STANDAARDOPMAAK).ParagraphFormat
            .Alignment = WdParagraphAlignment.wdAlignParagraphLeft
            .WidowControl = True
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
            .NoLineNumber = False
            .Hyphenation = True
            .FirstLineIndent = 0
            .OutlineLevel = WdOutlineLevel.wdOutlineLevelBodyText
            .CharacterUnitLeftIndent = 0
            .CharacterUnitRightIndent = 0
            .CharacterUnitFirstLineIndent = 0
            .MirrorIndents = False
            .TextboxTightWrap = WdTextboxTightWrap.wdTightNone
            .SpaceBefore = 0
            .SpaceAfter = 0
            .LineSpacingRule = WdLineSpacing.wdLineSpaceSingle
        End With

        doc.Styles(STANDAARDOPMAAK).NoSpaceBetweenParagraphsOfSameStyle = False
        doc.Styles(STANDAARDOPMAAK).BaseStyle = ""

        Try
            doc.Styles("Eindnoottekst").Font.Size = PuntgrootteParam - 2
            doc.Styles("Eindnoottekst").Font.Name = LettertypeParam
        Catch ex As Exception
            ' laat maar passeren
        End Try

        Try
            doc.Styles("Voetnoottekst").Font.Size = PuntgrootteParam - 2
            doc.Styles("Voetnoottekst").Font.Name = LettertypeParam
        Catch ex As Exception
            ' laat maar passeren
        End Try
    End Sub

    Private Sub LettertypeBasisInstellen(OpmaakstijlParam As String)
        With doc.Styles(OpmaakstijlParam).Font
            .Underline = WdUnderline.wdUnderlineNone
            .UnderlineColor = WdColor.wdColorAutomatic
            .StrikeThrough = False
            .DoubleStrikeThrough = False
            .Outline = False
            .Emboss = False
            .Shadow = False
            .Hidden = False
            .SmallCaps = False
            .AllCaps = False
            .Color = WdColor.wdColorAutomatic
            .Engrave = False
            .Superscript = False
            .Subscript = False
            .Scaling = 100
            .Kerning = 16
            .Animation = WdAnimation.wdAnimationNone
        End With

        With doc.Styles(OpmaakstijlParam).ParagraphFormat
            .LeftIndent = 0
            .RightIndent = 0
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = WdLineSpacing.wdLineSpaceSingle
            .LineUnitBefore = 0
            .LineUnitAfter = 0
        End With

        With doc.Styles(OpmaakstijlParam)
            .AutomaticallyUpdate = False
            .NextParagraphStyle = "Standaard"
            .LanguageID = WdLanguageID.wdBelgianDutch
            .QuickStyle = True
        End With
    End Sub

    Private Sub OpmaakstijlVerwijderen(StijlnaamParam As String)
        Try
            doc.Styles(StijlnaamParam).Delete()
        Catch ex As Exception
            ' doe maar verder
        End Try
    End Sub

    Private Sub SelectieAnnoteren(NotitieParam As String)
        NotitieParam = " </" & NotitieParam & ">"

        selectie.MoveDown(Unit:=WdUnits.wdParagraph, Count:=1)
        selectie.MoveLeft(Unit:=WdUnits.wdCharacter, Count:=1)
        selectie.TypeText(Text:=NotitieParam)
        selectie.MoveLeft(Unit:=WdUnits.wdCharacter, Count:=Len(NotitieParam), Extend:=WdMovementType.wdExtend)

        On Error Resume Next
        selectie.Style = doc.Styles("Lay-outaanwijzing")
    End Sub

    Private Sub TitelmarkeringenOpruimen()
        selectie.HomeKey(Unit:=WdUnits.wdStory)

        selectie.Find.ClearFormatting()
        selectie.Find.Replacement.ClearFormatting()

        ' Overbodige titelmarkering aan begin van regel verwijderen
        With selectie.Find
            .Text = "^p<<tussentitel>>"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = WdFindWrap.wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)

        With selectie.Find
            .Text = "^p<<titel>>"
            .Replacement.Text = "^p"
        End With
        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)

        ' Als die overbodige titelmarkering gevolgd werd door een spatie staat die daar nu verloren.
        With selectie.Find
            .Text = "^p "
            .Replacement.Text = "^p"
        End With
        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)

        ' Lay-outaanwijzingen na titelmarkering moeten op de volgende regel, voor het gemak.
        ' We houden rekening met 0, 1 en 2 spaties tussen beide aanwijzingen.
        With selectie.Find
            .Text = "<<einde titel>><<"
            .Replacement.Text = "<<einde titel>>^p<<"
        End With
        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)

        With selectie.Find
            .Text = "<<einde titel>> <<"
            .Replacement.Text = "<<einde titel>>^p<<"
        End With
        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)

        With selectie.Find
            .Text = "<<einde titel>>  <<"
            .Replacement.Text = "<<einde titel>>^p<<"
        End With
        selectie.Find.Execute(Replace:=WdReplace.wdReplaceAll)

        selectie.HomeKey(Unit:=WdUnits.wdStory)
    End Sub

End Class
